(in-package #:org.shirakumo.fraf.trial.release)

(defun bundle-path (bundle &key (version (version)) (output (output)))
  (let ((data (or (config :bundles bundle)
                  (error "No such bundle ~a" bundle))))
    (make-pathname :name (format NIL (or (getf data :file-format) "~(~a-~a-~a~)") (config :system) bundle version)
                   :type "zip"
                   :defaults output)))

(defmethod bundle ((bundle symbol) &key (version (version)) (output (output)) (release (release)) comment (recompress (config :bundle :recompress)))
  (let ((path (bundle-path bundle :version version :output output))
        (comment (or comment (multiple-value-bind (s m h dd mm yy) (decode-universal-time (get-universal-time))
                               (format NIL "Release created on ~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d" yy mm dd h m s))))
        (entries (make-array 0 :adjustable T :fill-pointer T))
        (depots (if (eql T (config :bundles bundle :depots))
                    (loop for (key) on (config :depots) by #'cddr collect key)
                    (config :bundles bundle :depots))))
    (flet ((entry (file file-name)
             (vector-push-extend (make-instance 'zippy:zip-entry :content file :file-name file-name) entries)))
      (dolist (depot depots)
        (dolist (mapping (config :depots depot))
          (destructuring-bind (source &optional target) (if (listp mapping) mapping (list mapping))
            (let ((source (merge-pathnames source release)))
              (cond ((wild-pathname-p source)
                     (dolist (file (directory source))
                       (let ((namestring (enough-namestring file source)))
                         ;; FIXME: I don't think the target mapping here is correct yet...
                         (entry file (if target (namestring (merge-pathnames namestring target)) namestring)))))
                    ((pathname-utils:directory-p source)
                     (loop with base = (or target (truename (pathname-utils:parent source)))
                           for path in (directory (merge-pathnames (merge-pathnames pathname-utils:*wild-file* pathname-utils:*wild-inferiors*)
                                                                   source))
                           do (entry path (enough-namestring path base))))
                    (T
                     (entry (merge-pathnames source release)
                            (or target (enough-namestring source release))))))))))
    (zippy:compress-zip (make-instance 'zippy:zip-file :entries entries :comment comment) path :if-exists :supersede)
    (when recompress
      (uiop:run-program (list "advzip" "-z" "-3" (pathname-utils:native-namestring path)) :output *standard-output* :error-output *standard-output*))
    path))

(defmethod bundle ((all cons) &rest args)
  (dolist (bundle all)
    (deploy:status 2 "Bundling ~a" bundle)
    (apply #'bundle bundle args)))

(defmethod bundle ((all (eql T)) &rest args)
  (dolist (bundle (coerce (config :bundle :targets) 'list))
    (deploy:status 2 "Bundling ~a" bundle)
    (apply #'bundle bundle args)))
